Attribute VB_Name = "WriteVar"
Dim pos As Integer
Dim arr(1 To 65536) As Byte
Dim chksum As String
Public IVarComment As String
Public IVarType As Byte
Public IVarName As String
Public IVarDataLen As Integer
Public IVarData As String
Function ReadVar(Path As String)
Dim a As Byte
Open Path For Binary As 1
'Header: 42,42,84,73,56,51,70,42,26,10,0 (Always same)
For r = 1 To 11
Get #1, , a
Next r
IVarComment = ""
'Comment: Text, then 0's so it takes up 42 bytes
For r = 1 To 42
Get #1, , a
If a <> 0 Then IVarComment = IVarComment + Chr(a)
Next r
dsl:
'6 Irrevelent bytes
For r = 1 To 6
Get #1, , a
Next r
'Var Type: Eg 5=Prog, 6=ProtProg, 21=Avar (Same as byte on calc)
Get #1, , IVarType
'Var Name: The name, then fill with 0's until its up to 8.
For r = 1 To 8
Get #1, , a
If a <> 0 Then IVarName = IVarName + Chr(a)
Next r
'4 More irrevelent bytes
For r = 1 To 4
Get #1, , a
Next r
'Length of data, in LLHH
Get #1, , a
jbc = Right("0" + Hex(a), 2)
Get #1, , a
jbd = Right("0" + Hex(a), 2) & jbc
For IVarDataLen = 0 To 30000
If Right("000" + Hex(IVarDataLen), 4) = jbd Then GoTo nax
Next IVarDataLen
nax: For r = 1 To IVarDataLen - 1
Get #1, , a
IVarData = IVarData & a & ","
Next r
Get #1, , a
IVarData = IVarData & a
Close 1
End Function
Function WriteVar(Path As String, VarName As String, VarType As Byte, TheData As String, Comment As String)
de = ""
chksum = 65535
pos = 0
i = 0
o = 0
lbl: f = i + 1
i = InStr(f, TheData + ",", ",")
If i = 0 Then GoTo nex
o = o + 1
arr(o) = Val(Mid(TheData + ",", f, i - f))
GoTo lbl
nex: Open Path For Binary As 1
'Header: 42,42,84,73,56,51,70,42,26,10,0 (Always same)
pout stb("*")
pout stb("*")
pout stb("T")
pout stb("I")
pout stb("8")
pout stb("3")
pout stb("F")
pout stb("*")
pout dec("1A")
pout dec("0A")
pout 0
'Comment: Text, then 0's so it takes up 42 bytes
sr = Comment + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0)
For r = 1 To 41
pout stb(Mid(sr, r, 1))
Next r
pout 0
'Data Len+19: LLHH format
pout dec(Right(Right("0000" + Hex(19 + o), 4), 2))
pout dec(Left(Right("0000" + Hex(19 + o), 4), 2))
'Var Header: 13,0
pcout 13
pcout 0
'Data Len+2: LLHH format
pcout dec(Right(Right("0000" + Hex(2 + o), 4), 2))
pcout dec(Left(Right("0000" + Hex(2 + o), 4), 2))
'Var Type: Eg 5=Prog, 6=ProtProg, 21=Avar (Same as byte on calc)
pcout VarType
'Var Name: The name, then fill with 0's until its up to 8.
VarName = VarName + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0) + Chr(0)
For lnt = 1 To 8
pcout stb(Mid(VarName, lnt, 1))
Next lnt
'Unknown Data: 0,0
pcout 0
pcout 0
'Data Len+2: LLHH
pcout dec(Right(Right("0000" + Hex(2 + o), 4), 2))
pcout dec(Left(Right("0000" + Hex(2 + o), 4), 2))
'Data Len: LLHH
pcout dec(Right(Right("0000" + Hex(o), 4), 2))
pcout dec(Left(Right("0000" + Hex(o), 4), 2))
'Data:
For r = 1 To o
pcout arr(r)
Next r
chk: chksum = chksum - 65535
If chksum > 65535 Then GoTo chk
'Checksum: LLHH
pout dec(Right(Right("0000" + Hex(chksum), 4), 2))
pout dec(Left(Right("0000" + Hex(chksum), 4), 2))
Close 1
End Function
Function pcout(Data As Byte)
chksum = chksum + Data
pout (Data)
End Function
Function pout(Data As Byte)
pos = pos + 1
Put #1, pos, Data
End Function
Function stb(Inp) As Byte
For sb = 0 To 255
If Chr(sb) = Inp Then GoTo sbt
Next sb
If sb = 256 Then sb = 255
sbt: stb = sb
End Function
Function dec(Inp As String) As Byte
For dc = 0 To 255
If Right("00" & Hex(dc), 2) = Inp Then GoTo dct
Next dc
dct: dec = dc
End Function
